;======================================START OF CORE FUNCTIONS==========================================
(deftemplate UI-state
   (slot id (default-dynamic (gensym*)))
   (slot display)
   (slot relation-asserted (default none))
   (slot response (default none))
   (slot answer-type (default multi-choice))    ;Available types : multi-choice, text
   (multislot valid-answers)
   (slot state (default middle)))
   
(deftemplate state-list
   (slot current)
   (multislot sequence))
  
(deffacts startup
   (state-list))

;Welcome message on the 1st page
(defrule system-banner 
  =>
  (assert (UI-state (display WelcomeMessage)
                    (relation-asserted start)
                    ;(relation-asserted begin_psnlt)
                    (state initial)
                    (valid-answers))))
                    
;;;*************************
;;;* GUI INTERACTION RULES *
;;;*************************
;;a new UI-state is asserted, add to the front of state-list and halt(why halt?)
;; 
(defrule ask-question

   (declare (salience 5))
   
   (UI-state (id ?id))
   
   ?f <- (state-list (sequence $?s&:(not (member$ ?id ?s))))
             
   =>
   
   (modify ?f (current ?id)
              (sequence ?id ?s))
   
   (halt))
;;if this is not a question (display screen for example) and this is not the current screen, 
;;move current pointer to its next question and halt 
(defrule handle-next-no-change-none-middle-of-chain

   (declare (salience 10))
   
   ?f1 <- (next ?id)

   ?f2 <- (state-list (current ?id) (sequence $? ?nid ?id $?))
                      
   =>
      
   (retract ?f1)
   
   (modify ?f2 (current ?nid))
   
   (halt))

;;if the current question is the newest(the first in state-list), and there is no response, assert (add-response ?id)
(defrule handle-next-response-none-end-of-chain

   (declare (salience 10))
   
   ?f <- (next ?id)

   (state-list (sequence ?id $?))
   
   (UI-state (id ?id)
             (relation-asserted ?relation))
                   
   =>
      
   (retract ?f)

   (assert (add-response ?id)))   

;;fire when the Next button is clicked and if response is the same as the last response, 
;;move current to the question in front and halt
;;handles the case when you click Prev and then click Next and your answer in that question doesnt change

(defrule handle-next-no-change-middle-of-chain

   (declare (salience 10))
   
   ?f1 <- (next ?id ?response)

   ?f2 <- (state-list (current ?id) (sequence $? ?nid ?id $?))
     
   (UI-state (id ?id) (response ?response))
   
   =>
      
   (retract ?f1)
   
   (modify ?f2 (current ?nid))
   
   (halt))

;;fire when the Next button is clicked and if response is not the same as the last response, 
;;remove all the questions in front of the current question
;;handles the case when you click Prev and then click Next and your answer in that question change
;;all the questions you have answers AFTER that question will ALL be discarded

(defrule handle-next-change-middle-of-chain

   (declare (salience 10))
   
   (next ?id ?response)

   ?f1 <- (state-list (current ?id) (sequence ?nid $?b ?id $?e))
     
   (UI-state (id ?id) (response ~?response))
   
   ?f2 <- (UI-state (id ?nid))
   
   =>
         
   (modify ?f1 (sequence ?b ?id ?e))
   
   (retract ?f2))
   
;;fire when user answer the latest question and click Next, assert (add-response ?id ?response)
(defrule handle-next-response-end-of-chain

   (declare (salience 10))
   
   ?f1 <- (next ?id ?response)
   
   (state-list (sequence ?id $?))
   
   ?f2 <- (UI-state (id ?id)
                    (response ?expected)
                    (relation-asserted ?relation))
                
   =>
      
   (retract ?f1)

   (if (neq ?response ?expected)
      then
      (modify ?f2 (response ?response)))
      
   (assert (add-response ?id ?response)))   


;;having add-response ?id ?response, making the relation by assert (?relation ?response) 
(defrule handle-add-response

   (declare (salience 10))
   
   (logical (UI-state (id ?id)
                      (relation-asserted ?relation)))
   
   ?f1 <- (add-response ?id ?response)
                
   =>
      
   (str-assert (str-cat "(" ?relation " " ?response ")"))
   
   (retract ?f1))   

;;having add-response ?id in non-question screen, jsut make the relation without answer
(defrule handle-add-response-none

   (declare (salience 10))
   
   (logical (UI-state (id ?id)
                      (relation-asserted ?relation)))
   
   ?f1 <- (add-response ?id)
                
   =>
      
   (str-assert (str-cat "(" ?relation ")"))
   
   (retract ?f1))   


;;move to the Previous question
(defrule handle-prev

   (declare (salience 10))
      
   ?f1 <- (prev ?id)
   
   ?f2 <- (state-list (sequence $?b ?id ?p $?e))
                
   =>
   
   (retract ?f1)
   
   (modify ?f2 (current ?p))
   
   (halt))
;======================================END OF CORE FUNCTIONS==========================================   
   
;======================================START OF COMMON FUNCTIONS========================================== 
;;;;;;;;;;;;;common template;;;;;;;;;;;;;
(deftemplate target_hard_fact (slot name) (slot gender)) ;Initial facts for hard constraint(gender/language/race etc)

(deftemplate person_CFs (slot name) (slot appearance-cf) (slot edujob-cf) (slot character-cf) (slot horoscope-cf)); for store cf factor of our 4 category
(deftemplate current_goal (slot category) (slot name) (slot cf)); final cf for appearance after combination.
(deftemplate working_goal (slot category) (slot name) (slot cf)); working targets' appearance cf for cf combination.

(deftemplate final_1 (slot name) (slot cf) (slot place)); Final Result
(deftemplate final (slot name) (slot cf) (slot place)); Final Result
;;;;;;;;;;;;end of common template;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Common CF combination for multiple conclusions RULES
;; You can treat this as a black-box!
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;combine POSITIVE certainty factors for multiple conclusions
;cf(cf1,cf2) = cf1 + cf2 * (1- cf1)

(defrule combine-positive-cf
	(declare (salience 10))
  ?f1 <- (current_goal (category ?cate1) (name ?name1) (cf ?cf1&:(>= ?cf1 0)))
  ?f2 <- (working_goal (category ?cate2&:(eq ?cate1 ?cate2)) (name ?name2&:(eq ?name1 ?name2)) (cf ?cf2&:(>= ?cf2 0)))
  (test (neq ?f1 ?f2)) ; test pointers and not value
  =>
  (retract ?f2)
  (modify ?f1 (cf =(+ ?cf1 (* ?cf2 (- 1 ?cf1)))))
)

;combine NEGATIVE cf
;cf(cf1,cf2) = cf1 + cf2 * (1 + cf1)

(defrule combine-neg-cf
 (declare (salience 10))
  ?f1 <- (current_goal (category ?cate1) (name ?name1) (cf ?cf1&:(<= ?cf1 0)))
  ?f2 <- (working_goal (category ?cate2&:(eq ?cate1 ?cate2)) (name ?name2&:(eq ?name1 ?name2)) (cf ?cf2&:(<= ?cf2 0)))
  (test (neq ?f1 ?f2))
  =>
  (retract ?f2)
  (modify ?f1 (cf =(+ ?cf1 (* ?cf2 (+ 1 ?cf1)))))
)

;combine one POSITIVE and one NEGATIVE
;cf(cf1,cf2) = (cf1 + cf2) / 1 - MIN[abs(cf1),abs(cf2)]

(defrule neg-pos-cf
 (declare (salience 10))
  ?f1 <- (current_goal (category ?cate1) (name ?name1) (cf ?cf1))
  ?f2 <- (working_goal (category ?cate2&:(eq ?cate1 ?cate2)) (name ?name2&:(eq ?name1 ?name2)) (cf ?cf2))
  (test (neq ?f1 ?f2))
  (test (< (* ?cf1 ?cf2) 0))
  =>
  (retract ?f2)
  (modify ?f1 (cf =(/ (+ ?cf1 ?cf2) (- 1 (min (abs ?cf1) (abs ?cf2))))))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; end of CF combination;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;======================================END OF COMMON FUNCTIONS==========================================